home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Word8.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  4.4 KB  |  127 lines  |  [TEXT/R*ch]
  1. (* Word8 -- new basis 1994-11-01, 1995-04-06, 1995-09-07 *)
  2.  
  3. (* This unit relies on two's complement representation *)
  4.  
  5. prim_eqtype word;
  6. val wordSize = 8;
  7.  
  8. (* Invariant for values w of type Word8.word: 0 <= wordToInt w < 256 *)
  9.  
  10. local
  11.     prim_val orb_       : word -> word -> word      = 2 "or";
  12.     prim_val andb_      : word -> word -> word      = 2 "and";
  13.     prim_val xorb_      : word -> word -> word      = 2 "xor";
  14.     prim_val lshift_    : word -> Word.word -> word = 2 "shift_left";
  15.     prim_val rshiftsig_ : word -> Word.word -> word = 2 "shift_right_signed";
  16.     prim_val rshiftuns_ : word -> Word.word -> word = 2 "shift_right_unsigned";
  17.     prim_val adduns_    : word -> word -> word      = 2 "+intunsig";
  18.     prim_val subuns_    : word -> word -> word      = 2 "-intunsig";
  19.     prim_val muluns_    : word -> word -> word      = 2 "*intunsig";
  20.     prim_val divuns_    : word -> word -> word      = 2 "divunsig";
  21.     prim_val moduns_    : word -> word -> word      = 2 "modunsig";
  22.  
  23.     prim_val intToWord_ : int -> word = 1 "identity";
  24.     fun norm w = andb_ w (intToWord_ 255);
  25.  
  26.     prim_val word2int   : Word.word -> int = 1 "identity";
  27. in
  28.     prim_val wordToInt : word -> int = 1 "identity";
  29.     fun signExtend w = if wordToInt w < 128 then (* msbit = 0 *)
  30.                wordToInt w
  31.                else                  (* msbit = 1 *)
  32.                wordToInt (orb_ w (intToWord_ ~256))
  33.     fun intToWord w  = norm (intToWord_ w);
  34.  
  35.     fun orb (x, y)  = orb_ x y;
  36.     fun andb (x, y) = andb_ x y;
  37.     fun xorb (x, y) = xorb_ x y;
  38.     fun notb x      = norm (xorb_ x (intToWord_ ~1)); 
  39.  
  40.     fun << (w, k) = 
  41.     if word2int k >= 8 orelse word2int k < 0 then intToWord_ 0
  42.     else norm (lshift_ w k);
  43.  
  44.     fun >> (w, k) = 
  45.     if word2int k >= 8 orelse word2int k < 0 then intToWord_ 0
  46.     else rshiftuns_ w k;
  47.  
  48.     fun ~>> (w, k) = 
  49.     if wordToInt w < 128 then    (* msbit = 0: no sign to extend  *)
  50.         if word2int k >= 8 orelse word2int k < 0 then intToWord_ 0
  51.         else rshiftuns_ w k
  52.     else                (* msbit = 1: extend, then shift *)
  53.         if word2int k >= 8 orelse word2int k < 0 then intToWord_ ~1
  54.         else norm (rshiftsig_ (orb_ w (intToWord_ ~256)) k);
  55.  
  56.     (* Redefining +, -, *, div, and mod is a horrible idea ... *)
  57.  
  58.     fun w1  +  w2 = norm (adduns_ w1 w2);
  59.     fun w1  -  w2 = norm (subuns_ w1 w2);
  60.     fun w1  *  w2 = norm (muluns_ w1 w2);
  61.     fun w1 div w2 = divuns_ w1 w2;
  62.     fun w1 mod w2 = moduns_ w1 w2;
  63.  
  64.     local 
  65.       open StringCvt
  66.       fun skipWSget getc source = getc (skipWS {getc=getc} source)
  67.  
  68.       (* Below, 48 = Char.ord #"0" and 55 = Char.ord #"A" - 10. *)
  69.       fun decval c = intToWord_ (Char.ord c) - intToWord_ 48;
  70.       fun hexval c = 
  71.       if #"0" <= c andalso c <= #"9" then 
  72.           intToWord_ (Char.ord c) - intToWord_ 48
  73.       else 
  74.           moduns_ (intToWord_(Char.ord c) - intToWord_ 55) (intToWord_ 32);
  75.  
  76.       fun prhex i = 
  77.       if wordToInt i < 10 then Char.chr(wordToInt (i + intToWord_ 48))
  78.       else Char.chr(wordToInt (i + intToWord_ 55));
  79.  
  80.       fun conv radix i = 
  81.       let fun h n res = 
  82.           if n = intToWord_ 0 then res
  83.           else h (divuns_ n radix) (prhex (moduns_ n radix) :: res)
  84.           fun tostr n = h (divuns_ n radix) [prhex (moduns_ n radix)]
  85.       in String.implode (tostr i) end
  86.  
  87.     in
  88.       fun scan radix {getc} source =
  89.       let open StringCvt
  90.           val (isDigit, factor) = 
  91.           case radix of
  92.               BIN => (fn c => (#"0" <= c andalso c <= #"1"),  2)
  93.             | OCT => (fn c => (#"0" <= c andalso c <= #"7"),  8)
  94.             | DEC => (Char.isDigit,                          10)
  95.             | HEX => (Char.isHexDigit,                       16)
  96.           fun dig1 NONE             = NONE
  97.         | dig1 (SOME (c, rest)) = 
  98.           let fun digr res src = 
  99.               case getc src of
  100.               NONE           => SOME (res, src)
  101.             | SOME (c, rest) => 
  102.                   if isDigit c then 
  103.                   digr(intToWord_ factor*res+hexval c) rest
  104.                   else 
  105.                   SOME (res, src)
  106.           in 
  107.               if isDigit c then digr (hexval c) rest 
  108.               else NONE 
  109.           end
  110.       in dig1 (skipWSget getc source) end;
  111.  
  112.       fun fmt BIN = conv (intToWord_  2)
  113.     | fmt OCT = conv (intToWord_  8)
  114.     | fmt DEC = conv (intToWord_ 10)
  115.     | fmt HEX = conv (intToWord_ 16)
  116.       fun toString w   = conv (intToWord_ 16) w
  117.       fun fromString s = scanString (scan HEX) s
  118.     end (* local for string functions *)
  119.  
  120.     val op > = fn (w1, w2) => wordToInt w1 > wordToInt w2;
  121.     fun w1 < w2  = w2 > w1;
  122.     fun w1 >= w2 = not (w1 < w2);
  123.     fun w1 <= w2 = not (w1 > w2);
  124.     fun compare (x, y: word) = 
  125.     if x<y then LESS else if x>y then GREATER else EQUAL;
  126. end
  127.